home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / microcrn / issue_46.arc / UNITS46.ARC / UNITS46.PAS
Encoding:
Pascal/Delphi Source File  |  1988-05-11  |  5.4 KB  |  158 lines
  1. (* Units and Modules Figure 1 - Rational Number Unit
  2.    Micro Cornucopia Magazine Issue #46 *)
  3.  
  4. unit Rational;
  5.  
  6. interface
  7.  
  8. type baseType = longint;          (* shortint, integer, longint *)
  9.      ratType = record
  10.                  n : baseType;    (* numerator of rational number *)
  11.                  d : baseType     (* denomenator of rational number *)
  12.                end;
  13.  
  14. function GCD(x, y : baseType) : baseType;
  15. function LCM(x, y : baseType) : baseType;
  16. procedure LowestTerms(var a : ratType);
  17. procedure ComDenom(var a, b : ratType);
  18. procedure IncRat(var a : ratType);
  19. procedure DecRat(var a : ratType);
  20. procedure ZeroRat(var a : ratType);
  21. procedure AddRat(a, b : ratType;var c : ratType);
  22. procedure SubRat(a, b : ratType;var c : ratType);
  23. procedure MultRat(a, b : ratType;var c : ratType);
  24. procedure DivRat(a, b : ratType;var c : ratType);
  25.  
  26. implementation
  27.  
  28. function GCD(x, y : baseType) : baseType;
  29.  
  30. (* function GCD finds the greatest common divisor of the two numbers
  31.    x and y by the Euclidian Algorithm. *)
  32.  
  33. var r, d : baseType;
  34. begin
  35.   if x < 0 then x := -1 * x;      (* set x = |x| *)
  36.   if y < 0 then y := -1 * y;      (* set y = |y| *)
  37.   if x < y then begin
  38.     r := y;                  (* swap x and y if y > x    *)
  39.     y := x;                  (* algorithm expects x >= y *)
  40.     x := r
  41.   end;
  42.   if y = 0 then
  43.     GCD := x
  44.   else
  45.   begin
  46.     repeat
  47.       d := x;             (* repeat Euclidian Algorithm until *)
  48.       x := y;
  49.       r := y;             (* a remainder of zero is obtained  *)
  50.       y := d mod r;
  51.     until y = 0;
  52.     GCD := r              (* then set GCD to be previous remainder *)
  53.   end
  54. end; (* GCD *)
  55.  
  56. function LCM(x, y : baseType) : baseType;
  57.  
  58. (* function LCM finds the least common multiple of the two numbers
  59.    x and y by determining the GCD of the two numbers and then applying
  60.    the rule |a*b| = GCD(a,b)*LCM(a,b)    *)
  61.  
  62. var g : baseType;
  63. begin
  64.   LCM := abs(x*y) div GCD(x, y)
  65. end; (* LCM *)
  66.  
  67. procedure LowestTerms(var a : ratType);
  68. var g : baseType;
  69. begin
  70.   if a.n = 0 then            (* if numerator then set denominator *)
  71.     a.d := 1                 (* to smallest positive number       *)
  72.   else
  73.     begin                    (* find the GCD of the numerator *)
  74.       g := GCD(a.n, a.d);    (* and the denominator           *)
  75.       a.n := a.n div g;      (* divide numerator by GCD       *)
  76.       a.d := a.d div g       (* divide denominator by GCD     *)
  77.     end
  78. end; (* LowestTerms *)
  79.  
  80. procedure ComDenom(var a, b : ratType);     (* find a common denominator *)
  81. var m : baseType;                           (* for a & b and adjust them *)
  82. begin
  83.   m := LCM(a.d, b.d);             (* find LCM of a.d and b.d *)
  84.   a.n := a.n * (m div a.d);       (* set a.n to new value    *)
  85.   a.d := m;                       (* set a.d to LCM of denominators *)
  86.   b.n := b.n * (m div b.d);       (* set b.n to new value    *)
  87.   b.d := m                        (* set b.d to LCM of denominators *)
  88. end; (* ComDenom *)
  89.  
  90. procedure IncRat(var a : ratType);     (* increment a by 1 *)
  91. begin
  92.   a.n := a.n + a.d;     (* add denominator to numerator *)
  93.   LowestTerms(a)        (* reduce a to lowest terms *)
  94. end; (* IncRat *)
  95.  
  96. procedure DecRat(var a : ratType);     (* decrement a by 1 *)
  97. begin
  98.   a.n := a.n - a.d;     (* subtract numerator from denominator *)
  99.   LowestTerms(a)        (* reduce a to lowest terms *)
  100. end; (* DecRat *)
  101.  
  102. procedure ZeroRat(var a : ratType);    (* set a to 0 *)
  103. begin
  104.   a.n := 0;   (* set numerator to zero *)
  105.   a.d := 1    (* set denominator to smallest positive number *)
  106. end; (* ZeroRat *)
  107.  
  108. procedure AddRat(a, b : ratType;       (* add a and b and place *)
  109.                  var c : ratType);     (* result in c, a+b = c  *)
  110. var l, g : baseType;
  111. begin
  112.   LowestTerms(a);       (* reduce a to lowest terms *)
  113.   LowestTerms(b);       (* reduce b to lowest terms *)
  114.   ComDenom(a, b);       (* convert a & b to common denominator *)
  115.   c.n := a.n + b.n;
  116.   c.d := a.d;
  117.   LowestTerms(c)        (* reduce c to lowest terms *)
  118. end; (* AddRat *)
  119.  
  120. procedure SubRat(a, b : ratType;       (* subtract b from a and place *)
  121.                  var c : ratType);     (* result in c, a-b = c        *)
  122. begin
  123.   LowestTerms(a);       (* reduce a to lowest terms *)
  124.   LowestTerms(b);       (* reduce b to lowest terms *)
  125.   ComDenom(a, b);       (* convert a & b to common denominator *)
  126.   c.n := a.n - b.n;
  127.   c.d := a.d;
  128.   LowestTerms(c)        (* reduce c to lowest terms *)
  129. end; (* SubRat *)
  130.  
  131. procedure MultRat(a, b : ratType;      (* multiply a and b and place *)
  132.                   var c : ratType);    (* result in c, a*b = c       *)
  133. begin
  134.   LowestTerms(a);       (* reduce a to lowest terms *)
  135.   LowestTerms(b);       (* reduce b to lowest terms *)
  136.   c.n := a.n * b.n;     (* multiply numerators      *)
  137.   c.d := a.d * b.d;     (* multiply denominators    *)
  138.   LowestTerms(c)        (* reduce c to lowest terms *)
  139. end; (* MultRat *)
  140.  
  141. procedure DivRat(a, b : ratType;       (* divide a by b and place *)
  142.                   var c : ratType);    (* result in c, a/b = c    *)
  143. begin
  144.   if b.n = 0 then
  145.     ZeroRat(c)          (* if division by 0 then c = 0 *)
  146.   else
  147.     begin
  148.       LowestTerms(a);   (* reduce a to lowest terms *)
  149.       LowestTerms(b);   (* reduce b to lowest terms *)
  150.       c.n := a.n * b.d; (* invert b and multiply by *)
  151.       c.d := a.d * b.n; (* a to get c               *)
  152.       LowestTerms(c)    (* reduce c to lowest terms *)
  153.     end
  154. end; (* DivRat *)
  155.  
  156. begin
  157. end.
  158.